home *** CD-ROM | disk | FTP | other *** search
/ Floppyshop 2 / Floppyshop - 2.zip / Floppyshop - 2.iso / art&graf.ix / art-0039 / source / dcdprint.mod < prev    next >
Text File  |  1997-04-16  |  12KB  |  369 lines
  1. IMPLEMENTATION MODULE DCDPrintImage;
  2.  
  3.  
  4. (*--------------------------------------------------------------------*)
  5. (*                                                                    *)
  6. (*   Run Image Dialog.                                                *)
  7. (*                                                                    *)
  8. (*   This is version 1.00         August 1988     L.G.Miller          *)
  9. (*                                                                    *)
  10. (*--------------------------------------------------------------------*)
  11.  
  12.  
  13. (*  IMPORT Trace;  *)
  14. FROM DCGlobal           IMPORT PictureImage,
  15.                                PrintImage,
  16.                                HiResMaxX,
  17.                                HiResMaxY,
  18.                    BITSPERWORD;
  19.  
  20. FROM SYSTEM             IMPORT ADDRESS, ADR;
  21.  
  22. FROM Strings            IMPORT String, Assign, Concat, Length;
  23.  
  24.  
  25. IMPORT Object;
  26.  
  27. IMPORT Forms;
  28. FROM   Forms            IMPORT DialAction;
  29.  
  30. IMPORT M2Conv;
  31.  
  32. IMPORT GemObjects;
  33.  
  34. FROM ManyWindows IMPORT
  35.  
  36.  
  37. (* VAR  *)
  38.  
  39.   AESApplId,           (* AES handle for this application *)
  40.   VDIHandle,           (* VDI handle of current Virtual Workstation *)
  41.  
  42.   ShowMouse,
  43.   HideMouse;
  44.  
  45. FROM Dcrsc      IMPORT
  46.    dpsize,
  47.  
  48.    dpszpicx,
  49.    dpszpicy,
  50.    dpszpicw,
  51.    dpszpich,
  52.  
  53.    dpszprtx,
  54.    dpszprty,
  55.    dpszprtw,
  56.    dpszprth,
  57.  
  58.    dpszland,
  59.  
  60.    dpszerrm,
  61.  
  62.    dpszcan,
  63.    dpszok;
  64.  
  65.  
  66. (* -------------------- End of IMPORTS ----------------------- *)
  67.  
  68. (*----------------------------------------------------------------------*)
  69. (*                  G L O B A L   T Y P E S                             *)
  70. (*----------------------------------------------------------------------*)
  71.  
  72. TYPE
  73.  
  74.   StringPtr = POINTER TO String; (* null terminated *)
  75.  
  76. (*----------------------------------------------------------------------*)
  77. (* Convert a string to a cardinal & check its within a range.           *)
  78. (*----------------------------------------------------------------------*)
  79. PROCEDURE StringToCardinal (     min, max : CARDINAL;
  80.                              VAR text     : ARRAY OF CHAR;
  81.                              VAR card     : CARDINAL ) : BOOLEAN;
  82.   VAR
  83.     done  : BOOLEAN;
  84.   BEGIN
  85.     card := M2Conv.ConvToCard( text );
  86.     RETURN ( done AND (( card >= min ) AND ( card <= max )) );
  87.   END StringToCardinal;
  88.  
  89.  
  90. (*----------------------------------------------------------------------*)
  91. (* Convert a cardinal to a string with a given width ( length? )        *)
  92. (*----------------------------------------------------------------------*)
  93. PROCEDURE CardinalToString (     n, width : CARDINAL;
  94.                              VAR text  : ARRAY OF CHAR );
  95.   BEGIN
  96.  
  97.     M2Conv.CardToString( n, width, text );
  98.   END CardinalToString;
  99.  
  100.  
  101. (*----------------------------------------------------------------------*)
  102. (*   Put given print image info into dialog.                            *)
  103. (*----------------------------------------------------------------------*)
  104. PROCEDURE PrintImageToDialog (  VAR printinfo : PrintImage );
  105.  
  106.   VAR str  : String;
  107.  
  108.   BEGIN
  109.  
  110.     CardinalToString( printinfo.StartCharX, 3, str ); (* x co-ord *)
  111.     GemObjects.SetTEDData( dpsize, dpszprtx, str );
  112.     GemObjects.DeselectObject( dpsize, dpszprtx );
  113.  
  114.     CardinalToString( printinfo.StartCharY, 3, str ); (* y co-ord *)
  115.     GemObjects.SetTEDData( dpsize, dpszprty, str );
  116.     GemObjects.DeselectObject( dpsize, dpszprty );
  117.  
  118.     CardinalToString( printinfo.Width, 4, str );      (* width *)
  119.     GemObjects.SetTEDData( dpsize, dpszprtw, str );
  120.     GemObjects.DeselectObject( dpsize, dpszprtw );
  121.  
  122.     CardinalToString( printinfo.Height, 4, str );     (* Height *)
  123.     GemObjects.SetTEDData( dpsize, dpszprth, str );
  124.     GemObjects.DeselectObject( dpsize, dpszprth );
  125.  
  126.     str := 'N';
  127.     IF printinfo.QueryLandscapePrint THEN str := 'Y' END;
  128.     GemObjects.SetTEDData( dpsize, dpszland, str );
  129.     GemObjects.DeselectObject( dpsize, dpszland );
  130.  
  131.   END PrintImageToDialog;
  132.  
  133.  
  134. (*----------------------------------------------------------------------*)
  135. (*   Print info from dialog to print image record. Hilight errors       *)
  136. (*----------------------------------------------------------------------*)
  137. PROCEDURE DialogToPrintImage (  VAR printinfo : PrintImage;
  138.                                 VAR errormsg  : ARRAY OF CHAR ) : BOOLEAN;
  139.                                                             (* true = ok *)
  140.  
  141.   VAR str  : String;
  142.       done, error : BOOLEAN;
  143.       i    : CARDINAL;
  144.   BEGIN
  145.     error := FALSE;
  146.     errormsg[0] := 0C;
  147.  
  148.     GemObjects.GetTEDData( dpsize , dpszprtx, str );
  149.     IF NOT StringToCardinal( 0, 75, str, i  ) THEN
  150.        error := TRUE;
  151.        GemObjects.SelectObject( dpsize, dpszprtx );
  152.        IF errormsg[0] = 0C THEN
  153.           Assign( 'Print: x ( 0 .. 75 )    ',errormsg);
  154.        END;
  155.     ELSE
  156.        printinfo.StartCharX := INTEGER(i);
  157.     END; (* if *)
  158.  
  159.     GemObjects.GetTEDData( dpsize, dpszprty, str );
  160.     IF NOT StringToCardinal( 0, 75, str, i ) THEN
  161.        error := TRUE;
  162.        GemObjects.SelectObject( dpsize, dpszprty );
  163.        IF errormsg[0] = 0C THEN
  164.           Assign( 'Print: y ( 0 .. 75 )    ',errormsg);
  165.        END;
  166.     ELSE
  167.        printinfo.StartCharY := INTEGER(i);
  168.     END; (* if *)
  169.  
  170.     GemObjects.GetTEDData( dpsize, dpszprtw, str );
  171.     IF NOT StringToCardinal( 0, 3000, str, i ) THEN
  172.        error := TRUE;
  173.        GemObjects.SelectObject( dpsize, dpszprtw );
  174.        IF errormsg[0] = 0C THEN
  175.           Assign( 'Print: width (0 .. 3000)', errormsg);
  176.        END;
  177.     ELSE
  178.        printinfo.Width := INTEGER(i);
  179.     END; (* if *)
  180.  
  181.     GemObjects.GetTEDData( dpsize, dpszprth, str );
  182.     IF NOT StringToCardinal( 0, 3000, str, i ) THEN
  183.        error := TRUE;
  184.        GemObjects.SelectObject( dpsize, dpszprth );
  185.        IF errormsg[0] = 0C THEN
  186.           Assign( 'Print: height (0 .. 3000)', errormsg);
  187.        END;
  188.     ELSE
  189.        printinfo.Height := INTEGER(i);
  190.     END; (* if *)
  191.  
  192.     GemObjects.GetTEDData( dpsize, dpszland, str );
  193.     str[0] := CAP(str[0]);
  194.     IF str[0] # 'Y' THEN str[0] := 'N' END;
  195.     printinfo.QueryLandscapePrint :=  ( str[0] = 'Y' );
  196.     GemObjects.SetTEDData( dpsize, dpszland, str );
  197.     GemObjects.DeselectObject( dpsize, dpszland );
  198.  
  199.     RETURN NOT error;
  200.   END DialogToPrintImage;
  201.  
  202.  
  203. (*----------------------------------------------------------------------*)
  204. (*   Put given picture image info into dialog.                          *)
  205. (*----------------------------------------------------------------------*)
  206. PROCEDURE PictureImageToDialog (  VAR pictureinfo : PictureImage );
  207.  
  208.   VAR str  : String;
  209.  
  210.   BEGIN
  211.     CardinalToString( pictureinfo.StartX, 3, str ); (* x co-ord *)
  212.     GemObjects.SetTEDData( dpsize, dpszpicx, str );
  213.     GemObjects.DeselectObject( dpsize, dpszpicx );
  214.  
  215.     CardinalToString( pictureinfo.StartY, 3, str ); (* y co-ord *)
  216.     GemObjects.SetTEDData( dpsize, dpszpicy, str );
  217.     GemObjects.DeselectObject( dpsize, dpszpicy );
  218.  
  219.     CardinalToString( pictureinfo.Width, 3, str );  (* width *)
  220.     GemObjects.SetTEDData( dpsize, dpszpicw, str );
  221.     GemObjects.DeselectObject( dpsize, dpszpicw );
  222.  
  223.     CardinalToString( pictureinfo.Height, 3, str ); (* Height *)
  224.     GemObjects.SetTEDData( dpsize, dpszpich, str );
  225.     GemObjects.DeselectObject( dpsize, dpszpich );
  226.  
  227.   END PictureImageToDialog;
  228.  
  229.  
  230. (*----------------------------------------------------------------------*)
  231. (*   Picture info from dialog to picture image record. Hilight errors   *)
  232. (*----------------------------------------------------------------------*)
  233. PROCEDURE DialogToPictureImage  ( VAR pictureinfo : PictureImage;
  234.                                   VAR errormsg  : ARRAY OF CHAR ) : BOOLEAN;
  235.                                                             (* true = ok *)
  236.   VAR str : String;
  237.       done, error : BOOLEAN;
  238.       i    : CARDINAL;
  239.   BEGIN
  240.     error := FALSE;
  241.     errormsg[0] := 0C;
  242.  
  243.     GemObjects.GetTEDData( dpsize , dpszpicx, str );
  244.     IF NOT StringToCardinal( 0, 640, str, i ) THEN
  245.        error := TRUE;
  246.        GemObjects.SelectObject( dpsize, dpszpicx );
  247.        IF errormsg[0] = 0C THEN
  248.           Assign('Pic: x ( 0 ..640 )', errormsg);
  249.        END;
  250.     ELSE
  251.        pictureinfo.StartX := INTEGER(i);
  252.     END; (* if *)
  253.  
  254.     GemObjects.GetTEDData( dpsize, dpszpicy, str );
  255.     IF NOT StringToCardinal( 0, 400, str, i ) THEN
  256.        error := TRUE;
  257.        GemObjects.SelectObject( dpsize, dpszpicy );
  258.        IF errormsg[0] = 0C THEN
  259.           Assign( 'Pic: y ( 0 ..400 )    ', errormsg);
  260.        END;
  261.     ELSE
  262.        pictureinfo.StartY := INTEGER(i);
  263.     END; (* if *)
  264.  
  265.     GemObjects.GetTEDData( dpsize, dpszpicw, str );
  266.     IF NOT StringToCardinal( 0, 640, str, i ) THEN
  267.        error := TRUE;
  268.        GemObjects.SelectObject( dpsize, dpszpicw );
  269.        IF errormsg[0] = 0C THEN
  270.           Assign( 'Pic: width (0 .. 640)', errormsg);
  271.        END;
  272.     ELSE
  273.        pictureinfo.Width := INTEGER(i);
  274.     END; (* if *)
  275.  
  276.     GemObjects.GetTEDData( dpsize, dpszpich, str );
  277.     IF NOT StringToCardinal( 0, 400, str, i ) THEN
  278.        error := TRUE;
  279.        GemObjects.SelectObject( dpsize, dpszpich );
  280.        IF errormsg[0] = 0C THEN
  281.           Assign( 'Pic: height (0 .. 400)', errormsg);
  282.        END;
  283.     ELSE
  284.        pictureinfo.Height := INTEGER(i);
  285.     END; (* if *)
  286.  
  287.     IF NOT error THEN
  288.       IF pictureinfo.StartX + pictureinfo.Width > HiResMaxX THEN
  289.          pictureinfo.Width := HiResMaxX + 1 - pictureinfo.StartX
  290.       END; (* if *)
  291.  
  292.       IF pictureinfo.StartY + pictureinfo.Height > HiResMaxY THEN
  293.          pictureinfo.Height := HiResMaxY + 1 - pictureinfo.StartY
  294.       END; (* if *)
  295.     END; (* if error *)
  296.  
  297.     RETURN NOT error;
  298.   END DialogToPictureImage;
  299.  
  300.  
  301. (*----------------------------------------------------------------------*)
  302. (*  Run dialog to get print/picture image details from the user         *)
  303. (*----------------------------------------------------------------------*)
  304. PROCEDURE DoImageDialog ( VAR picimage : PictureImage;
  305.                           VAR prtimage : PrintImage   );
  306.   VAR SavePicImage : PictureImage;
  307.       SavePrtImage : PrintImage;
  308.  
  309.       dTree      : ADDRESS ;
  310.       x, y, w, h, dumc : CARDINAL ;
  311.       result     : INTEGER;
  312.       i          : INTEGER;
  313.       errptr       : StringPtr;
  314.       errmsg     : ARRAY [ 0 .. 25 ] OF CHAR;
  315.  
  316.   BEGIN
  317.     FOR i := 0 TO HIGH(errmsg) DO errmsg[i]:= ' ' END;
  318.     errmsg[HIGH(errmsg)] := 0C;
  319.     errptr := GemObjects.GetObjectSpec(dpsize, dpszerrm);
  320.     Assign(errmsg,errptr^);
  321.  
  322.     SavePicImage := picimage;
  323.     SavePrtImage := prtimage;
  324.  
  325.     PrintImageToDialog(prtimage);
  326.     PictureImageToDialog(picimage);
  327.  
  328.  
  329.     dTree := GemObjects.TreePointer( dpsize );
  330.     Forms.form_center(dTree, x, y, w, h) ;
  331.     dumc := Forms.form_dial(ReserveSpace, 0, 0, 0, 0, x, y, w, h) ;
  332.     dumc := Forms.form_dial(ExpandBox, 0, 0, 0, 0, x, y, w, h) ;
  333.     LOOP
  334.       GemObjects.DeselectObject(dpsize, dpszok) ;
  335.       GemObjects.DeselectObject(dpsize, dpszcan) ;
  336.       dumc := Object.objc_draw(dTree, 0, 10, x, y, w, h) ;
  337.       result := Forms.form_do( dTree, dpszpicx );
  338.       IF result = dpszcan THEN
  339.          picimage := SavePicImage;
  340.          prtimage := SavePrtImage;
  341.          EXIT;
  342.       END; (* if *)
  343.  
  344.       IF DialogToPictureImage( picimage, errmsg ) THEN
  345.  
  346.          IF DialogToPrintImage( prtimage, errmsg ) THEN
  347.             EXIT (* all ok *)
  348.  
  349.          ELSE
  350.  
  351.             Assign(errmsg,errptr^);
  352.          END; (* if *)
  353.  
  354.       ELSE
  355.  
  356.          Assign(errmsg,errptr^);
  357.       END; (* if *)
  358.  
  359.     END; (* loop *)
  360.  
  361.     dumc := Forms.form_dial(ShrinkBox, 0, 0, 0, 0, x, y, w, h) ;
  362.     dumc := Forms.form_dial(FreeSpace, 0, 0, 0, 0, x, y, w, h) ;
  363.  
  364.   END DoImageDialog;
  365.  
  366. END DCDPrintImage.
  367.  
  368.  
  369.